*@PROCESS DC(BLANK)
      PROGRAM COBRA
C
      PARAMETER (IDSIZE=1000000)
      COMMON  /BLANK/ DATA(IDSIZE)
C
C     PARAMETER IDSIZE CONTROLS TYPE OF ALLOCATION
C     IF IDSIZE = 1, ALLOCATION IS DYNAMIC (SUBROUTINE ZIGET
C                         IS REQUESTED)
C     IF IDSIZE > 1, ALLOCATION IS FIXED, I.E. BLANK COMMON HAS
C                    FIXED LENGTH = IDSIZE (A DUMMY SUBROUTINE
C                    ZIGET MAY BE SUPPLIED)
C
      INCLUDE 'COBRA1'
      COMMON /CLOCKT/ DTIME(20)
C
      COMMON /IOUNIT/ ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                NTHU,OUTFIL,PLTFIL,SAVFIL
      INTEGER         ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                OUTFIL,PLTFIL,SAVFIL
C
      CHARACTER*20 RUNDAT
C
      INFILE=5
      OUTFIL=6
      PLTFIL=7
      AUXFIL=99
      OPEN(UNIT=INFILE,FILE='INPFILE',STATUS='OLD')
      OPEN(UNIT=OUTFIL,FILE='OUTFILE',STATUS='UNKNOWN')
C
      IASIZE=IDSIZE
        CALL GETCOR (DATA,IASIZE,IORG,OUTFIL)
      IF(IDSIZE.EQ.1) THEN
        WRITE (OUTFIL,2003) IASIZE,IORG
      ELSE
        WRITE (OUTFIL,2004) IASIZE
      END IF
      CALL DAYTIM (RUNDAT)
      WRITE (OUTFIL,100) RUNDAT(1:10),RUNDAT(11:20)
  100 FORMAT(///5X,'COBRA-EN PROBLEM'/
     X          5X,'EXECUTED ON: ',A,5X,'AT TIME: ',A)
2003  FORMAT (///1X,'DYNAMIC CORE ALLOCATION',
     X               I8,' WORDS (4 BYTES) OF STORAGE RESERVED'/
     X           1X,'ORIGIN OF WORKING AREA=',I6)
2004  FORMAT (///1X,'FIXED   CORE ALLOCATION',
     X               I8,' WORDS (4 BYTES) OF STORAGE REQUIRED')
C
C     ECHOPRINT OF INPUT CARDS
C
      CALL PROCIN (AUXFIL,INFILE,OUTFIL)
      INFILE=AUXFIL
      NTHU=INFILE
      DO 10 I=1,10
10    DTIME(I)=0.0
C-----READ INPUT DATA
      CALL THDATA(IORG,1)
      IF(NPLOT.NE.0) OPEN(UNIT=PLTFIL,FILE='PLOTFILE',STATUS='UNKNOWN')
C-----PRINT INPUT DATA
      CALL THDATA(IORG,2)
C-----PERFORM CALCULATION
      CALL THPROC
      STOP
      END
      SUBROUTINE MAFLC4 (AA,IDIAG,INIR,ISOR,NITEM,NNN,NPAGE,NPLAN,NPX,
     1      NPX1,NPX2,NPY1,NPY2,TTL,VET,BU0,CODE)
C
C     IDIAG=INDICE DI SIMMETRIA DIAGONALE
C     NNN=0 TABULAZIONE DI UNA QUANTITA DEFINITA PER CELLE RETICOLARI
C        =1 TABULAZIONE DI UNA QUANTITA DEFINITA PER PUNTI
C     NPX=NUMERO DI COLONNE
C     NPX1=CONTORNO SINISTRO DELLA REGIONE DA TABULARE
C     NPX2=CONTORNO DESTRO  DELLA REGIONE DA  TABULARE
C     NPY1=CONTORNO SUPERIORE DELLA REGIONE DA  TABULARE
C     NPY2=CONTORNO INFERIORE DELLA REGIONE DA  TABULARE
C     VET=QUANTITA BIDIMENSIONALE DA TABULARE
C     INIR=INDICE DELLA PRIMA RIGA -1
C     ISOR=INDICE DI GRUPPO (SE 0, VIENE TRASCURATO)
C     NPLAN=INDICE DI PIANO (SE NEGATIVO, VIENE TRASCURATO)
C     NITEM=NUMERO DI QUANTITA PER PUNTO O CELLA
C     TTL=TITLE OF PROBLEM
C     BU0=TOTAL BURN UP
C
C
      COMMON /IOUNIT/ ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                NTHU,OUTFIL,PLTFIL,SAVFIL
      INTEGER         ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                OUTFIL,PLTFIL,SAVFIL
C
      DIMENSION VET(NITEM,1)
      CHARACTER*4 AA(10)
      DIMENSION TITLE(18),A(130),Z(19),CODE(4)
      DIMENSION TTL(18)
      DATA Z           /1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H0,1H1,1H2,
     11H ,1H ,4H  PL,4HANE ,2HX=,2HY=,2HZ=/
      DATA TITLE/18*1H /
C
 1000 FORMAT(2H  ,25A4,I2,3A4,I3)
 1001 FORMAT (1H ,115A1)
 1002 FORMAT (4H ROW)
 1003 FORMAT(I4,1X,1P,10E11.4)
 1004 FORMAT(5X,1P,10E11.4)
 1005 FORMAT (  /7H COLUMN)
 2000 FORMAT(1X,28A4,1X,I3)
 2100 FORMAT(1X,25A4,' BETWEEN PLANES ',A2,I3,' AND ',A2,I3)
 2200 FORMAT (1X,25A4,I2,' BETWEEN PLANES ',A2,I3,' + ',A2,I3)
 4000 FORMAT(1H1,1X ,'C O B R A - E N ',18A4,' AT ',4A4,F10.4,
     X                  ' PAGE',I4//)
C
      NP=(NPX*(NPX+1))/2-NPX
      NCOL=NPX2+1-NPX1
      ILLE=MOD(NCOL,10)
      IF(NCOL.EQ.1) ILLE=0
      II=11
      IF(NNN.EQ.0) II=5
   19 IBOT=NPY1
   36 IF(IBOT.NE.NPY1.AND.NNN.NE.0) IBOT=IBOT+1
      ITOP=IBOT
      IBOT=IBOT-1+50/(NITEM+1)
      IF(IBOT.GT.NPY2) IBOT=NPY2
    1 NPAG=NPX1
   34 NPAG1=NPAG
      NPAG=NPAG+10
      IF(NPAG.GT.NPX2) NPAG=NPX2
    3 CONTINUE
      NFPL=NPLAN-1
      WRITE (OUTFIL,4000) (TTL(JI),JI=1,18),CODE,BU0,NPAGE
      NPAGE=NPAGE+1
      IF(ISOR)2,4,2
    2 IF(NPLAN.LT.0) THEN
        WRITE(OUTFIL,1000) (TITLE(K),K=1,18),(AA(K),K=1,7),ISOR
      ELSE IF(NNN.NE.0) THEN
        WRITE (OUTFIL,1000) (TITLE(K),K=1,18),(AA(K),K=1,7),ISOR,
     +                       (AA(K),K=8,10),NPLAN
      ELSE
        WRITE (OUTFIL,2200) (TITLE(K),K=1,18), (AA(K),K=1,7),ISOR,
     1                       AA(10),NFPL,AA(10),NPLAN
      END IF
      GO TO 18
    4 IF(NPLAN.LT.0) THEN
        WRITE(OUTFIL,2000) (TITLE(K),K=1,18),(AA(K),K=1,10)
      ELSE IF(NNN.NE.0) THEN
        WRITE (OUTFIL,2000) (TITLE(K),K=1,18),(AA(K),K=1,10),NPLAN
      ELSE
        WRITE (OUTFIL,2100) (TITLE(K),K=1,18),(AA(K),K=1,7 ),
     +                       AA(10),NFPL,AA(10),NPLAN
      END IF
   18 WRITE (OUTFIL,1005)
      NPA1=NPAG-NPAG1
      IF(NPAG.EQ.NPX2.AND.NNN.NE.0.AND.ILLE.NE.1) NPA1=NPA1+1
      NPA=NPA1*11+5-5*NNN
      DO 5 J=1,NPA
    5 A(J)=Z(13)
      IF(NPAG1-1)6,6,7
    6 A(NPA)=Z(1)
      IF(NPX2.LT.10) A(NPA)=Z(13)
      KOR2=1
      IF(NNN)233,8,233
    8 A(104)=Z(1)
  233 WRITE (OUTFIL,1001) (A(K),K=1,NPA)
      GO TO 23
    7 KAR0=NPAG/100
      KOR0=NPAG1/100
      IF(KOR0)9,9,10
   10 DO 11 K=II,NPA,11
   11 A(K)=Z(KOR0)
      IF(KOR0-KAR0)12,13,13
   12 KK=(KAR0*100-NPAG1)*11+5+6*NNN
      DO 14 K=KK,NPA,11
   14 A(K)=Z(KAR0)
   13 WRITE (OUTFIL,1001) (A(K),K=1,NPA)
      GO TO 15
    9 IF(KAR0)15,15,12
   15 KOR1=NPAG1/10-10*KOR0
      KAR1=NPAG/10-10*KAR0
      IF(KOR1.EQ.0.AND.NPAG1.EQ.NPX1) GO TO 17
      KKK=KOR1
      IF(KKK.EQ.0)KKK=10
      DO 16 K=II,NPA,11
   16 A(K)=Z(KKK)
   17 KKKT=KOR1-KAR1
      IF(KKKT.EQ.9) GO TO 20
      IF(KKKT.GE.0) GO TO 21
   20 KK=(KOR1*10+10+KOR0*100-NPAG1)*11+5+6*NNN
      KKK=KAR1
      IF(KKK.EQ.0)KKK=10
      DO 22 K=KK,NPA,11
   22 A(K)=Z(KKK)
   21 WRITE (OUTFIL,1001) (A(K),K=1,NPA)
      KOR2=NPAG1-KOR0*100-KOR1*10
      IF(KOR2.EQ.0) KOR2=10
   23 DO 24 K=II,NPA,11
      A(K)=Z(KOR2)
      KOR2=KOR2+1
      IF(KOR2.GE.11) KOR2=1
   24 CONTINUE
      WRITE (OUTFIL,1001) (A(K),K=1,NPA)
      WRITE (OUTFIL,1002)
      IF(NNN)28,27,28
   27 KK=ITOP+1
      LL1=NPAG
      WRITE (OUTFIL,1003) ITOP
      KK1=NPAG1+1
      GO TO 29
   28 KK=ITOP
      KK1=NPAG1
      LL1=NPAG-1
      IF(NPAG.EQ.NPX2.AND.ILLE.NE.1) LL1=LL1+1
   29 DO 33 K=KK,IBOT
      DO 33 NJ=1,NITEM
      I1=1
      DO 30 L=KK1,LL1
      I=(K-1)*NPX+L
      IF(IDIAG.EQ.0) GO TO 25
      I=NP+L-((NPX-K)*(NPX-K+1))/2
      IF(L.LT.K) I=NP+K    -((NPX-L)*(NPX-L+1))/2
   25 A(I1)=VET(NJ,I)
   30 I1=I1+1
      IAR=K+INIR
      IF(NNN.EQ.0) THEN
        WRITE (OUTFIL,1004) (A(I),I=1,NPA1)
        IF(NJ.EQ.NITEM) WRITE (OUTFIL,1003) IAR
      ELSE
        IF(NJ.EQ.1) WRITE (OUTFIL,1003) IAR,(A(I),I=1,NPA1)
        IF(NJ.GT.1) WRITE (OUTFIL,1004) (A(I),I=1,NPA1)
        IF(NJ.EQ.NITEM) WRITE (OUTFIL,1004)
      END IF
   33 CONTINUE
      IF(NPAG-NPX2)34,35,35
   35 IF(ILLE.NE.1.OR.NNN.EQ.0) GO TO 38
      ILLE=22
      GO TO 34
   38 IF(ILLE.EQ.22) ILLE=1
      IF(IBOT-NPY2)36,37,37
   37 RETURN
      END
      SUBROUTINE READIN (QF,QTAB,X,XTAB)
C
      INCLUDE 'COBRA1'
      INCLUDE 'COBRA3'
      INCLUDE 'UNIT'
C
      COMMON /IOUNIT/ ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                NTHU,OUTFIL,PLTFIL,SAVFIL
      INTEGER         ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                OUTFIL,PLTFIL,SAVFIL
C
      REAL QF(MR,MX),QTAB(MX,MR),X(MX),XTAB(MX)
C
C
      NN=MIN(NDX,6)
      READ (INFILE,1200) (X(J+1),J=1,NN)
      DX=X(2)
      IF(DX .LT.0.) THEN
         DO 100 J=1,NDX
100      X(J+1)=-DX
      ELSE IF(NDX.GT.6) THEN
         READ (INFILE,1200) (X(J+1),J=7,NDX)
      END IF
      X(1)=0.
      DO 110 J=1,NDX
      DX = X(J+1)
110   X(J+1)=X(J)+DX
      READ (INFILE,1100) NAXP
      IF(NAXP.GT.NDX) GO TO 200
      DO 120 J=1,NAXP
      READ (INFILE,1200) XTAB(J)
      READ (INFILE,1200) (QTAB(J,N),N=1,NROD)
  120 CONTINUE
      DO 130 J=1,NDX
      ISAVE=1
      XOUT=0.5*(X(J+1)+X(J))
      DO 130 N=1,NROD
      CALL EXTRAP (YOUT,XOUT,QTAB(1,N),XTAB,NAXP,ISAVE)
      QF(N,J+1)=YOUT
      ISAVE=2
  130 CONTINUE
      DO 140 J=1,NDX
        CONVXX=1.0
        IF(ISIN.EQ.2) CONVXX=FCV(1)
        X(J+1)=X(J+1)/CONVXX
        CONVXX=3600.
        IF(ISIN.EQ.2) CONVXX=CONVXX*FCV(12)/FCV(1)
        DO 140 N=1,NROD
          QF(N,J+1)=QF(N,J+1)/CONVXX
140   CONTINUE
      Z=X(NDX+1)
C
      RETURN
  200 WRITE (OUTF,1300) NAXP,NDX
      STOP
 1100 FORMAT (12I6)
 1200 FORMAT (6E12.5)
 1300 FORMAT (/5X,'PROGRAM STOP: AXIAL LEVELS (',I5,') EXCEED AXIAL',
     +  ' LEVELS IN COMPUTATIONAL GRID (',I5,')')
      END
*@PROCESS DC(BLANK)
      SUBROUTINE THDATA (IORG,IPART)
C
      INCLUDE 'COBRA4'
      INCLUDE 'COBRA1'
      INCLUDE 'COBRA3'
      INCLUDE 'LINK2'
      INCLUDE 'LINK3'
      INCLUDE 'UNIT'
      INCLUDE 'FUELM'
C
      COMMON /IOUNIT/ ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                NTHU,OUTFIL,PLTFIL,SAVFIL
      INTEGER         ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                OUTFIL,PLTFIL,SAVFIL
C
      PARAMETER (IDSIZE=1000000)
      COMMON /BLANK/ DATA(IDSIZE)
C
      CHARACTER*6 SIGNAL(6)
      CHARACTER*20 RUNDAT
      DATA SIGNAL /'MAIN  ','CHAN  ','MODEL ','OPERA ',
     X             'TABLES','GENDAT'/
      DATA HOL1/1H /
C
C-----CONTROL FOR THERMAL-HYDRAULIC INPUT DATA
      IF(IPART.EQ.2) GO TO 300
      KASE=0
      DO 100 I=1,20
      TEXT(I)=HOL1
      IF(I.LE.2) DATE(I)=HOL1
  100 CONTINUE
      PI=3.141592654
      GC=32.2
      HCRIT=906.
      PRCRIT=3208.2
      TCRIT=705.5
      NAXL=0
      NGXL=0
      NAX=1
      IERROR=0
      NGAPS=0
      NAFACT=0
      J5=0
      J6=0
      NOPRIN=0
      J7=0
      JUMP=0
      NJUMP=0
      NRAMP=1
      NOUT=0
      NARAMP=1
      ISAVE=0
      GRID=.FALSE.
      CALL FCONV
C     OUTF is the output filenumber for thermal-hydraulics
      OUTF=OUTFIL
C-----GENERAL PARAMETERS
      READ (INFILE,1005) (TEXT(I),I=1,18)
      CALL DAYTIM(RUNDAT)
      WRITE (OUTFIL,1100) (TEXT(I),I=1,18),RUNDAT(1:10),RUNDAT(13:20)
      READ (INFILE,1110) IQP3,ISIN,ISOUT,JTHMOD
      READ (NTHU,1110) IPILE,NCHANL,NROD,NDX,NCTYP,NGRID,NGRIDT,
     X                 NODESF,IGCON,IDIAGH,IVEC2,NFUELT
C     NOVECTOR OPTION IS DEFAULT FOR IBM AND NOVEC IS DICTATED FOR PC
C     IF(IVEC2.EQ.0) IVEC2=1
      IVEC2=1
      NFXF=0
      IF (IQP3.EQ.0) THEN
        NCHANB=NROD
        NROD=NCHANL-NCHANB
      ELSE
        NCHANB=0
      END IF
      IF(JTHMOD.EQ.2) THEN
        IPILE=2
        IVEC2=1
      END IF
      IFMOD=0
      IF (NODESF.GT.0) THEN
        IFMOD=1
      ELSE IF (NODESF.EQ.-1) THEN
        IFMOD=2
        NODESF=3
      ELSE IF (NODESF.EQ.-2) THEN
        IFMOD=3
        NODESF=5
      END IF
      MC=NCHANL
      MN=NODESF+2
      MR=NROD
      MX=NDX+2
      IF(IQP3.EQ.0) IGCON=0
      IF(NFUELT.EQ.0 .AND. (IFMOD.EQ.1 .OR. IFMOD.EQ.3)) GO TO 907
      IF(NFUELT.GT.10) GO TO 907
      IF(NCTYP.LE.0) GO TO 908
      CALL THYMEM (1,IORG)
      CALL THYMEM (2,IORG)
C     NOTICE: the array FLUX and XC are used temporarily in READIN
C             the array FLUX will be used later on for thermal flux
C             the array XC will be involved in CPR calculations
      CALL READIN (DATA(JQF),DATA(JFLUX),DATA(JX),DATA(JXC))
      CALL CHAN (DATA(JA),DATA(JCD),DATA(JD),DATA(JDHYD),DATA(JDIST),
     1      DATA(JFACTO),DATA(JGAP),DATA(JGAPS),
     2      DATA(JHPERI),DATA(JIDFUE),DATA(JIK),INFILE,
     3      1,DATA(JJBSTO),DATA(JJK),DATA(JLC),DATA(JLENGT),DATA(JLR),
     4      DATA(JNBYPS),NTHU,DATA(JNTYPE),DATA(JPERIM),DATA(JPHI))
      CALL THYMEM(3,IORG)
      CALL CHAN (DATA(JA),DATA(JCD),DATA(JD),DATA(JDHYD),DATA(JDIST),
     1      DATA(JFACTO),DATA(JGAP),DATA(JGAPS),
     2      DATA(JHPERI),DATA(JIDFUE),DATA(JIK),INFILE,
     3      2,DATA(JJBSTO),DATA(JJK),DATA(JLC),DATA(JLENGT),DATA(JLR),
     4      DATA(JNBYPS),NTHU,DATA(JNTYPE),DATA(JPERIM),DATA(JPHI))
      IF(IERROR.GT.1) GO TO 910
      CALL MODEL(DATA(JBINLE),DATA(JFINLE),INFILE,1)
      IF(IERROR.GT.1) GO TO 910
      CALL THYMEM(4,IORG)
      CALL OPERA(DATA(JHINLE),DATA(JIFBOR),INFILE,1,DATA(JTINLE))
      IF(IERROR.GT.1) GO TO 910
      CALL TABLES (INFILE,1,DATA(JPRNTC),DATA(JPRNTN),DATA(JPRNTR))
      IF(IERROR.GT.1) GO TO 910
      RETURN
C-----EDIT OF T-H INPUT DATA
  300 CONTINUE
      NROW=50
      WRITE (OUTFIL,1003)
      WRITE (OUTFIL,1500) JTHMOD
      CALL CHAN (DATA(JA),DATA(JCD),DATA(JD),DATA(JDHYD),DATA(JDIST),
     1      DATA(JFACTO),DATA(JGAP),DATA(JGAPS),
     2      DATA(JHPERI),DATA(JIDFUE),DATA(JIK),INFILE,
     3      3,DATA(JJBSTO),DATA(JJK),DATA(JLC),DATA(JLENGT),DATA(JLR),
     4      DATA(JNBYPS),NTHU,DATA(JNTYPE),DATA(JPERIM),DATA(JPHI))
      IF(IERROR.GT.1) GO TO 910
      CALL OPERA(DATA(JHINLE),DATA(JIFBOR),INFILE,2,DATA(JTINLE))
      IF(IERROR.GT.1) GO TO 910
      CALL MODEL(DATA(JBINLE),DATA(JFINLE),INFILE,2)
      IF(IERROR.GT.1) GO TO 910
      CALL TABLES (INFILE,2,DATA(JPRNTC),DATA(JPRNTN),DATA(JPRNTR))
      CALL THYMEM(5,IORG)
      RETURN
C
  907 WRITE (OUTFIL,1907)
 1907 FORMAT (//5X,'NO FUEL TYPE OR NUMBER OF FUEL TYPES',
     X             'GREATER THAN 10')
      GO TO 5000
  908 WRITE (OUTFIL,1908)
 1908 FORMAT (//5X,'ERROR, NO CHANNEL TYPE SPECIFIED')
      GO TO 5000
  910 WRITE (OUTFIL,1910) SIGNAL(IERROR)
 1910 FORMAT (/5X,'ERROR IN ',A6,' *CALCULATION STOPPED')
 5000 STOP
C
 1003 FORMAT(1H1///30X,'PROCESSED THERMAL-HYDRAULIC INPUT DATA'/30X,
     1                 '--------------------------------------'/)
 1005 FORMAT (20A4)
 1100 FORMAT(1H1///5X,'COBRA-EN THERMAL-HYDRAULIC'/
     X             5X,'RUN IDENTIFICATION'/
     X             7X,'PROBLEM TITLE: ',18A4/
     X             7X,'RUN DATE: ',A/
     X             7X,'RUN DAY TIME: ',A)
 1110 FORMAT (12I6)
 1500 FORMAT (///10X,'VAPOR CONTINUITY EQUATION INCLUDED IN ',
     X'THERMAL-HYDRAULIC MODEL?',I4,
     X    ' (0=NO, 1=YES FOR COBRA MODEL, 2=YES FOR TWIGL MODEL)')
      END
*@PROCESS DC(BLANK)
      SUBROUTINE THPROC
C
      INCLUDE 'COBRA4'
      INCLUDE 'COBRA1'
      INCLUDE 'LINK2'
      INCLUDE 'LINK3'
C
      COMMON /IOUNIT/ ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                NTHU,OUTFIL,PLTFIL,SAVFIL
      INTEGER         ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                OUTFIL,PLTFIL,SAVFIL
C
      PARAMETER (IDSIZE=1000000)
      COMMON /BLANK/ G(IDSIZE)
C
      CALL WSUMRY (G(JD),G(JHPERI),G(JPHI),G(JPPK),G(JQF),G(JX))
C-----START FLUID FIELD SOLUTION
      
	open(123456,file='shuchu.dat')


      ICONV=1
      ITER=0
      THTIM=0.
      ETIME=THTIM
      DELTAT=0.
      KSP=NSKIPS
      IAVER=1
      ITHSTP=-1
  100 ITHSTP=ITHSTP+1
      IF(NDT.GT.0) THEN
        DO L=1,NDT
          IF(ETIME.LT.TDELT(L)) GO TO 110
        END DO
  110   DT=DELTV(L)
        NSKIPT=NTOUT(L)
        SAVEDT=DT
        TDOLD=0.0
        IF(L.GT.1) TDOLD=TDELT(L-1)
        IF(NSKIPT.LT.1) NSKIPT=(TDELT(L)-TDOLD)/DELTV(L)
      ENDIF
      KSP=KSP+1
      ISHPR=0
      IF(KSP.GE.NSKIPS) THEN
        ISHPR=1
        KSP=0
      ENDIF
C     THE FOLLOWING STATEMENT TO FORCE EDIT AT TRANSIENT END
      IF(ETIME.GE.TTIME-DT) THEN
        NSKIPT=0
        ISHPR=1
      ENDIF
C
      IF(ISHPR.EQ.1) WRITE (OUTFIL,1000) ITHSTP
      PRINT *, ' Time step no.', ITHSTP
1000  FORMAT (/1X,'TIME STEP NO.',I6)
C
      CALL CALC (G(JA),G(JAAA),G(JAAAA),G(JAGB),G(JALFAP),G(JALFOL),
     X  G(JAXLB),G(JB),G(JBINLE),G(JBORC),G(JBOROL),G(JBWGHT),
     X  G(JCCHAN),G(JCD),G(JCHFR),G(JCON),G(JCOND),G(JCP),G(JCPR),
     X  G(JCSAVE),G(JD),G(JDELP),G(JDFDP),G(JDFDX),G(JDGVDA),G(JDGVDM),
     X  G(JDHDX),G(JDHYD),G(JDPDX),G(JDPK),G(JDPSAV),G(JDQVAP),
     X  G(JDSLIP),G(JDWDP),G(JEPRK),G(JERRC),G(JESAVE),G(JF),G(JFACTO),
     X  G(JFINLE),G(JFLM),G(JFLMOL),G(JFLUX),G(JFLXO),G(JFMULT),
     X  G(JFOLD),G(JFSP),G(JFSAVE),G(JFVM),G(JFVMOL),
     X  G(JGAMV),G(JGAP),G(JGLT),G(JGVT),G(JH),
     X  G(JHBOR),G(JHFLM2),G(JHGAP),G(JHINLE),G(JHLM),G(JHLMOL),
     X  G(JHLT),G(JHOLD),G(JHPERI),G(JHSURF),
     X  G(JHSURV),G(JIDFUE),G(JIFBOR),G(JIK),
     X  G(JIPVT),G(JITCPR),G(JJBOIL),G(JJK),G(JJSAT),
     X  G(JKMATE),G(JKNODE),G(JLENGT),G(JLR),G(JMASND),G(JMCFRC),
     X  G(JMCFRR),G(JMCHFR),G(JMODE),G(JNBYPS),G(JNTYPE),G(JP),G(JPC),
     X  G(JPCRIT),G(JPERIM),G(JPHI),G(JPOLD),G(JPPK),
     X  G(JPRNTC),G(JPRNTN),G(JPRNTR),G(JQCHF),G(JQCLAD),
     X  G(JQF),G(JQFB),G(JQFUEL),G(JQINT),G(JQPRIM),G(JQVAP),
     X  G(JRBOUN),G(JRHO),G(JRHOLL),G(JRHOOL),
     X  G(JRHOQ),G(JRHOVV),G(JRTEMP),G(JSATQ),G(J$SLIP),
     X  G(JSP),G(JT),G(JTCHF),G(JTDUM1),G(JTDUM2),G(JTDUM3),G(JTFLUD),
     X  G(JTFLUV),G(JTINLE),G(JTROD),G(JTROLD),G(JU),G(JUH),
     X  G(JUSAVE),G(JUSTAR),G(JV),G(JVISC),G(JVISCW),G(JVOLND),G(JVP),
     X  G(JVXOLD),G(JW),G(JWOLD),G(JWP),G(JWSAVE),G(JX),
     X  G(JXC),G(JXE),G(JX$A),G(JX$B),
     X  DELTAT,ICONV,ITER,ITHSTP,THTIM)
      IF (ICONV.EQ.0) THEN
        WRITE (OUTFIL,2100)
        STOP
      ENDIF
      

      write(*,*)  'HAHAHHA'
	WRITE(123456,*)   


      IF(ETIME.LT.TTIME-1.e-6) GO TO 100
      RETURN
 2100 FORMAT (/5X,'*** THERMAL-HYDRAULICS FAILED TO CONVERGE ***')
      END
      SUBROUTINE WSUMRY (D,HPERI,PHI,PPK,QF,X)
C
      INCLUDE 'COBRA1'
      INCLUDE 'COBRA3'
      INCLUDE 'LINK2'
      INCLUDE 'LINK3'
      INCLUDE 'UNIT'
C
      COMMON /IOUNIT/ ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                NTHU,OUTFIL,PLTFIL,SAVFIL
      INTEGER         ASSFIL,AUXFIL,BURFIL,GETFIL,INFILE,KINFIL,LIBFIL,
     X                OUTFIL,PLTFIL,SAVFIL
C
      REAL D(MR),HPERI(MC),PHI(MR,6),PPK(MR,MX),QF(MR,MX),X(MX)
C
      DIMENSION XINT(7)
      CHARACTER HEAD1*9,HEAD2*9
      CHARACTER*4 HEAD(10)
      REAL CODE(4)
      DATA HEAD /'LINE','AR F','ISSI','ON P','OWER','    ','    ',
     X           '(MBT','U/HR','/FT)'/
      DATA CODE/4H   T,4HIME ,4H(SEC,4H)  =/
C
      IF (IQP3.EQ.0) THEN
         HEAD1='   CORE  '
         HEAD2=' CHANNEL '
      ELSE
         HEAD1='  CHANNEL'
         HEAD2=' FUEL ROD'
      END IF
C-----TOTAL POWER AT STEADY STATE
      SUMF=0.
      ZCORE=0.
C-----AHTOT IS TO ACCOUNT FOR FUEL RODS OR ASSEMBLIES OF DIFFERENT
C     LENGTH
      AHTOT=0.0
      DO 110 N=1,NDX
      DX=X(N+1)-X(N)
      JCORE=0
      DO 100 L=1,NROD
      PPK(L,N+1)=1.0
      QF(L,N+1)=QF(L,N+1)*FNORM
      QCAL=QF(L,N+1)*DX
      IF(QCAL.NE.0.0) JCORE=1
      IF(IQP3.EQ.0) THEN
        FRAC=1.0
        PHROD=HPERI(L)
      ELSE
        FRAC=0.0
        DO 120 J=1,6
  120    FRAC=FRAC+PHI(L,J)
        PHROD=D(L)*PI
      END IF
      IF(QCAL.GT.0.0) AHTOT=AHTOT+PHROD*DX*FRAC
      SUMF=SUMF+QCAL*FRAC
  100 CONTINUE
      IF(JCORE.NE.0) ZCORE=ZCORE+DX
  110 CONTINUE
      SUMF=SUMF*3600.
C
      WRITE (OUTFIL,1000)
 1000 FORMAT(1H1////' ===== SUMMARY OUTPUT FROM POWER DISTRIBUTION ',
     X           '(COBRA-EN) =====')
      WRT1=SUMF*FCV(12)
      WRT2=SUMF
      WRITE (OUTFIL,1003) HEAD1,WRT2,WRT1
      AFLUX=SUMF/AHTOT
      WRITE (OUTFIL,1006) HEAD1,AFLUX,AFLUX*FCV(13)
 1003 FORMAT ( //A9, ' FISSION POWER    = ',1P,E13.6,' BTU/HR',5X,'IE',
     1 E13.6,' W ')
 1006 FORMAT (/A9, ' AVERAGE HEAT FLUX = ',1P,E13.6,' BTU/FT2/HR ',5X,
     1           'IE',E13.6,' W/M2 ')
C-----TEST PRINTING
C-----JTP=0, NO PRINTING
C-----JTP=1, SUMMARY ONLY
C-----JTP=2, DETAILS OF POWER TRANSFERRED
      JTP=2
      IF(JTP.EQ.0) GO TO 400
      RFF=-1.0
      SUMX=-1.0
      SUMN=1.0E06
      DO 420 J=1,NDX
      SMAX=-1.0
      SUM=0.
      PHAXL=0.0
      DO 410 I=1,NROD
      WV=QF(I,J+1)
      IF(IQP3.EQ.0) THEN
        FRAC=1.
        PHROD=HPERI(I)
      ELSE
        FRAC=0.0
        DO 430 L=1,6
  430    FRAC=FRAC+PHI(I,L)
        PHROD=D(I)*PI
      END IF
      SUM=SUM+WV*FRAC
      WV=WV/PHROD
      IF(WV.GT.0.0) PHAXL=PHAXL+PHROD*FRAC
      IF(WV.GT.SMAX) SMAX=WV
  410 CONTINUE
      IF(SUM.EQ.0.) GO TO 420
      WV=SMAX*PHAXL/SUM
      IF(WV.GT.RFF) THEN
        RFF=WV
        L=J
      END IF
  420 CONTINUE
      AFF=-1.0
      DO 450 I=1,NROD
      SMAX=-1.0
      SUM=0.
      ZHROD=0.0
      DO 440 J=1,NDX
        DX = X(J+1) - X(J)
        WV = QF(I,J+1)
        IF(WV.GT.SMAX) SMAX=WV
        IF(WV.GT.0.0) ZHROD=ZHROD+DX
  440 SUM = SUM + WV * DX
      IF(SUM.EQ.0.) GO TO 450
      WV = SMAX * ZHROD/ SUM
      IF(WV.GT.AFF) THEN
        AFF=WV
        M=I
      END IF
      IF(IQP3.EQ.0) THEN
        VV=SUM/HPERI(I)
      ELSE
        VV=SUM/(D(I)*PI)
      END IF
      IF(VV.GT.SUMX) THEN
        SUMX=VV
        LL=I
        ZHMAX=ZHROD
      END IF
      IF(VV.LT.SUMN) THEN
        SUMN=VV
        LLL=I
        ZHMIN=ZHROD
      END IF
  450 CONTINUE
      WRITE (OUTFIL,3003) RFF,L,AFF,HEAD2,M
      SUMX = 3600. * SUMX / ZHMAX
      SUMN = 3600. * SUMN / ZHMIN
      WV=AFLUX
      WVX=SUMX/WV
      WVN=SUMN/WV
      IF (ISOUT.EQ.1) THEN
         WRITE (OUTFIL,3004) HEAD2,LL,SUMX,WVX,HEAD2,WV,
     X                       HEAD2,LLL,SUMN,WVN
      ELSE
         WRITE (OUTFIL,3014) HEAD2,LL,SUMX*FCV(13),WVX,HEAD2,WV*FCV(13),
     X                       HEAD2,LLL,SUMN*FCV(13),WVN
      END IF
C-----2-D MAP OF LINEAR FISSION POWER (X=ROD OR CHANNEL, Y=AXIAL INTRVL)
      IF(JTP.EQ.1) GO TO 400
      NPAGE=1
      CONVXX=3600.
      HEAD(8)='(BTU'
      HEAD(9)='/HR)'
      HEAD(10)='    '
      IF(ISOUT.EQ.2) THEN
        CONVXX=CONVXX*FCV(12)/FCV(1)
        HEAD(8)='(W/M'
        HEAD(9)=')   '
        HEAD(10)='    '
      END IF
      DO 510 J=1,NDX
      DO 510 N=1,NROD
      QF(N,J+1)=QF(N,J+1)*CONVXX
  510 CONTINUE
      TTXX=0.0
      CALL MAFLC4(HEAD,0,0,0,1,1,NPAGE,-1,NROD,1,NROD,1,NDX,TEXT,
     X            QF(1,2),TTXX,CODE)
C-----INTEGRATED POWER PER CHANNEL OR ROD
      NROW=50
      IROW=NROW
      N2=0
530   N1=N2+1
      N2=MIN(N2+7,NROD)
      IF(IROW.GE.NROW) THEN
        WRITE (OUTFIL,3000) (TEXT(I),I=1,18)
        WRITE (OUTFIL,3001) HEAD2,HEAD(8),HEAD(9),HEAD(10)
        IROW=5
      END IF
      DO 540 N=N1,N2
      I=N-N1+1
      XINT(I)=0.
      DO 540 J=1,NDX
      DX=X(J+1)-X(J)
      IF(ISOUT.EQ.2) DX=DX*FCV(1)
      XINT(I)=XINT(I)+QF(N,J+1)*DX
540   CONTINUE
      I1=1
      I2=N2-N1+1
      WRITE (OUTFIL,3002) N1,N2,(XINT(I),I=I1,I2)
      IROW=IROW+1
      IF(N2.LT.NROD) GO TO 530
      DO 550 J=1,NDX
      DO 550 N=1,NROD
      QF(N,J+1)=QF(N,J+1)/CONVXX
550   CONTINUE
  400 CONTINUE
 3000 FORMAT (1H1,4X,'PROBLEM TITLE: ',18A4)
 3001 FORMAT (//5X,A9,5X,'INTEGRATED POWER ',3A4/)
 3002 FORMAT (5X,I3,' -',I3,3X,1P,7E12.5)
 3003 FORMAT (//'  MAX. RADIAL FORM FACTOR = ',F7.3,'  AT AXIAL INTERVAL
     1   ',I3/  '  MAX. AXIAL  FORM FACTOR = ',F7.3,'  IN ',A8,1X,I11)
 3004 FORMAT (/'  MAXIMUM RATED ',A9,' IS NO.',I4,
     X         ' WITH AVERAGE HEAT FLUX =',E12.5,' BTU/FT2/HR IE',F8.4,
     X         ' TIMES AVERAGE'/
     X         '  AVERAGE RATED ',A9,11X,
     X         ' WITH AVERAGE HEAT FLUX =',E12.5,' BTU/FT2/HR'/
     X         '  MINIMUM RATED ',A9,' IS NO.',I4,
     X         ' WITH AVERAGE HEAT FLUX =',E12.5,' BTU/FT2/HR IE',F8.4,
     4         ' TIMES AVERAGE')
 3014 FORMAT (/'  MAXIMUM RATED ',A9,' IS NO.',I4,
     X         ' WITH AVERAGE HEAT FLUX =',E12.5, ' W/M2 IE',F8.4,
     X         ' TIMES AVERAGE'/
     X         '  AVERAGE RATED ',A9,11X,
     X         ' WITH AVERAGE HEAT FLUX =',E12.5,' W/M2'/
     X         '  MINIMUM RATED ',A9,' IS NO.',I4,
     X         ' WITH AVERAGE HEAT FLUX =',E12.5,' W/M2 IE',F8.4,
     X         ' TIMES AVERAGE')
C
      RETURN
      END
